VERSION 5.00
Begin VB.Form fMain 
   AutoRedraw      =   -1  'True
   Caption         =   "Threaded DirScan-Demo"
   ClientHeight    =   6960
   ClientLeft      =   60
   ClientTop       =   435
   ClientWidth     =   10485
   LinkTopic       =   "Form1"
   ScaleHeight     =   464
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   699
   StartUpPosition =   3  'Windows-Standard
   Begin VB.PictureBox picPreview 
      Appearance      =   0  '2D
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   1215
      Left            =   8700
      ScaleHeight     =   79
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   79
      TabIndex        =   13
      Top             =   120
      Width           =   1215
   End
   Begin VB.TextBox txtCurFile 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   1620
      Locked          =   -1  'True
      TabIndex        =   12
      Top             =   1035
      Width           =   6615
   End
   Begin VB.CheckBox chkFilter 
      Caption         =   "*.bmp"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   6
      Left            =   7440
      TabIndex        =   10
      Top             =   600
      Value           =   1  'Aktiviert
      Width           =   900
   End
   Begin VB.CheckBox chkFilter 
      Caption         =   "*.gif"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   5
      Left            =   6480
      TabIndex        =   9
      Top             =   600
      Value           =   1  'Aktiviert
      Width           =   900
   End
   Begin VB.CheckBox chkFilter 
      Caption         =   "*.png"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   4
      Left            =   5520
      TabIndex        =   8
      Top             =   600
      Value           =   1  'Aktiviert
      Width           =   900
   End
   Begin VB.CheckBox chkFilter 
      Caption         =   "*.jpg"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   3
      Left            =   4560
      TabIndex        =   7
      Top             =   600
      Value           =   1  'Aktiviert
      Width           =   900
   End
   Begin VB.CheckBox chkFilter 
      Caption         =   "*.svgz"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   2
      Left            =   3540
      TabIndex        =   6
      Top             =   600
      Value           =   1  'Aktiviert
      Width           =   900
   End
   Begin VB.CheckBox chkFilter 
      Caption         =   "*.svg"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   1
      Left            =   2580
      TabIndex        =   5
      Top             =   600
      Value           =   1  'Aktiviert
      Width           =   900
   End
   Begin VB.CheckBox chkFilter 
      Caption         =   "*.ico"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   1620
      TabIndex        =   3
      Top             =   600
      Value           =   1  'Aktiviert
      Width           =   900
   End
   Begin DirScanDemo.ucVList VList 
      Height          =   3015
      Left            =   120
      TabIndex        =   2
      Top             =   1620
      Width           =   4095
      _ExtentX        =   7223
      _ExtentY        =   5318
   End
   Begin VB.CommandButton cmdCancelScan 
      Caption         =   "Cancel Scan"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   540
      Width           =   1335
   End
   Begin VB.CommandButton cmdStartScan 
      Caption         =   "Start Scan"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1335
   End
   Begin VB.Timer tmrUpdateResults 
      Interval        =   30
      Left            =   3360
      Top             =   60
   End
   Begin VB.Label lblFileName 
      Alignment       =   2  'Zentriert
      Caption         =   "Current File:"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   180
      TabIndex        =   11
      Top             =   1080
      Width           =   1215
   End
   Begin VB.Label lblSearchPath 
      Appearance      =   0  '2D
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fest Einfach
      Caption         =   "C:\"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   270
      Left            =   1620
      TabIndex        =   4
      ToolTipText     =   "Click, to change the Search-Path"
      Top             =   165
      Width           =   270
   End
End
Attribute VB_Name = "fMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private WithEvents TH As cThreadHandler, FilesCount As Long
Attribute TH.VB_VarHelpID = -1
Private Cnn As cConnection, Rs As cRecordset, ThmbCache As New cThmbCache
 
Private Sub Form_Load()
  VList.HeaderHeight = 30
  VList.RowHeight = 30
 
  'first let's instantiate the ThreadClass (regfree) on its own thread, returning "a ThreadHandler (TH)"
  Dim ThreadKey$: ThreadKey = "DirScanKey_" & App.ThreadID 'build a unique ThreadKey
  Dim ThreadLib$: ThreadLib = App.Path & "\DirScanThreadLib.dll" 'define the Path of the ThreadDll
  Set TH = New_c.RegFree.ThreadObjectCreate(ThreadKey, ThreadLib, "cThread")
  
  'Now we make use of SQLites new "FileURI"-support, to create an InMemory-DB which is accessible across Threads
  'This MemDB will take up the Search-Results in a Table named [Scan], by inserting them as Records on the WorkerThread...
  'Here in the Main-Thread we can then perform reads against this "shared MemDB", in parallel to the running "threaded Inserts"
  Set Cnn = New_c.Connection
      Cnn.CreateNewDB "file:DirScanDB?mode=memory&cache=shared" 'open an InMem-Connection with a "shared-memory-FileURI"
      Cnn.Execute "Pragma read_uncommitted=1" 'allow the Client, to "see" even the uncommitted inserts, the thread will perform
      Cnn.Execute "Create Table If Not Exists Scan(ID Integer Primary Key, FileDate Date, FileLen Integer, FileName Text, FilePath Text)"
End Sub

Private Sub Form_Resize()
  Dim PicH: PicH = txtCurFile.Top + txtCurFile.Height - 9
  picPreview.Move ScaleWidth - PicH - 9, 9, PicH, PicH
  txtCurFile.Width = IIf(picPreview.Left - txtCurFile.Left - 9 > 0, picPreview.Left - txtCurFile.Left - 9, 1)
  VList.Move 0, PicH + 18, ScaleWidth, IIf(ScaleHeight - PicH - 18 > 0, ScaleHeight - PicH - 18, 1)
End Sub
 
Private Sub lblSearchPath_Click()
Dim NewSearchPath As String
    NewSearchPath = New_c.FSO.ShowFoldersDialog("Choose a Drive or Folder", lblSearchPath.Caption, , , BIF_NEWDIALOGSTYLE, Me.hWnd)
    If Len(NewSearchPath) Then lblSearchPath.Caption = NewSearchPath
End Sub

Private Sub cmdStartScan_Click()
  Set picPreview.Picture = Nothing
  txtCurFile.Text = vbNullString
  FilesCount = 0
  Set Rs = Nothing
  VList.ListCount = FilesCount
  
  New_c.Timing True 'take the start-time (will be stopped, when the thread has finished the async job)
  If Not TH.IsConnected Then TH.ReConnect
  TH.CallAsync "StartScan", lblSearchPath.Caption, GetFilterString  'now we start our new DirScan here
End Sub

Private Sub cmdCancelScan_Click()
  TH.CancelExecution 'cancel a potentially still running threaded Scan-Job
End Sub

Private Function GetFilterString() As String
Dim i As Long, j As Long, Arr() As String
  For i = 0 To chkFilter.UBound 'make a semicolon-separated FilterString out of the chkBox-States
    If chkFilter(i).Value Then ReDim Preserve Arr(j): Arr(j) = chkFilter(i).Caption: j = j + 1
  Next
  If j Then GetFilterString = Join(Arr, ";")
End Function

'Our TH-Object is the clientside ThreadHandler, who's able to communicate with the Thread
'delegating appropriate Events here, when results come back (in case of the async-calls)
Private Sub TH_MethodFinished(MethodName As String, Result As Variant, ErrString As String, ErrSource As String, ByVal ErrNumber As Long)
  If ErrNumber Then Debug.Print "TH-Err:"; MethodName; ErrString, ErrSource, ErrNumber: Exit Sub
  FilesCount = Result 'store the final Result in a Form-wide visible Variable (used for List-Refreshes in the Update-Timer)
  Caption = "Scan finished with " & FilesCount & " Files" & New_c.Timing
End Sub
'and here's the place, where User-Events will be received (when Raised from the Thread-Class)
Private Sub TH_ThreadEvent(MethodName As String, EventName As String, ByVal ParamCount As Long, P1 As Variant, P2 As Variant, P3 As Variant, P4 As Variant, P5 As Variant, P6 As Variant, P7 As Variant, P8 As Variant)
  If EventName = "ScanProgress" Then FilesCount = P1
End Sub

Private Sub VList_Click(ByVal Index As Long, ByVal ColIndex As Long)
Dim RowIdx As Long, CC As cCairoContext
    RowIdx = Index - VList.TopIndex
  If Rs Is Nothing Then Exit Sub Else If RowIdx < 0 Or RowIdx >= Rs.RecordCount Then Exit Sub
  
  txtCurFile.Text = Rs.ValueMatrix(RowIdx, 4) & Rs.ValueMatrix(RowIdx, 3)
  Set CC = Cairo.CreateSurface(picPreview.ScaleWidth, picPreview.ScaleWidth).CreateContext
      CC.Paint , Cairo.CreateSolidPatternLng(vbWhite)
      CC.RenderSurfaceContent ThmbCache.GetSrfFromFile(txtCurFile.Text, CC.Surface.Width, 0), 0, 0, CC.Surface.Width, CC.Surface.Height, , , True
  Set picPreview.Picture = CC.Surface.Picture
End Sub

Private Sub VList_OwnerDrawHeader(ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long)
  Dim ColW(1 To 7) As Long 'the ColWidth-Definition of a given VList is done per code here (not in some Dialogue)
      ColW(1) = dy + 13    'the first Col will show the Image-Thumbs (loaded dynamically from the current Image-File)
      ColW(2) = 110        'the second the Image-Dimensions (if they are determinable)
      ColW(3) = 60              'Col3 gets mapped to RsFldIdx 0 (ID) in the OwnerDrawItem-Routine below
      ColW(4) = 140             'Col4 gets mapped to RsFldIdx 1 (FileDate)
      ColW(5) = 90              'Col5 gets mapped to RsFldIdx 2 (FileSize)
      ColW(6) = (x + dx) * 0.15 'Col6 gets mapped to RsFldIdx 3 (FileName)
      'the final Col7 gets mapped to RsFldIdx 4 (FilePath) - and its size is adjusted dynamically here, to avoid showing the HScrollBar
      ColW(7) = dx - (ColW(1) + ColW(2) + ColW(3) + ColW(4) + ColW(5) + ColW(6)) - VList.ScrollerSize
  
  VList.FillRectangle hDC, x, y, dx, dy * 0.45, &HFFFFFF '<- Header-BackColor
  VList.Font.Bold = True
  
  Dim i As Long
  For i = 1 To UBound(ColW)
    VList.DrawTextCell hDC, Choose(i, "", "ImgDimensions", "ID", "FileDate", "FileLen", "FileName", "FilePath"), IIf(i < 6, DT_RIGHT, DT_LEFT), x, y, ColW(i), dy, , , , 5
    x = x + ColW(i): If i < UBound(ColW) Then VList.DrawLineVert hDC, x - 1, y, dy
  Next
  
  VList.Font.Bold = False 'reset the bold Font, so that the Routine below will again have it as it was
  VList.DrawLineHorz hDC, 0, y, dx, &HBBBBBB 'horizontal line at the Top of the header
  VList.DrawLineHorz hDC, 0, y + dy - 1, dx, &HBBBBBB 'horizontal line at the Bottom of the header-stripe
End Sub

Private Sub VList_OwnerDrawItem(ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal Index As Long, ByVal IsSelected As Boolean)
Dim i As Long, RowIdx As Long, FileName As String, BGColor As Long
Static CurTopIndex As Long, CurVisibleRows As Long, CC As cCairoContext

  If CC Is Nothing Then Set CC = Cairo.CreateSurface(dy - 1, dy - 1).CreateContext
  
  If Rs Is Nothing Or CurTopIndex <> VList.TopIndex Or CurVisibleRows <> VList.VisibleRows Then
     CurTopIndex = VList.TopIndex
     CurVisibleRows = VList.VisibleRows
     'the Rs is retrieved with only as many Records as needed, to fill the currently "VisibleRows" of the VList (takes only 1 msec or so)
     Set Rs = Cnn.OpenRecordset("Select * From Scan Where ID > " & CurTopIndex & " Limit " & CurVisibleRows + 1)
  End If
  
  BGColor = VList.BackColor
  If IsSelected Then BGColor = IIf(VList.Focused, &HFFE8D0, &HEEEEEE): VList.FillRectangle hDC, x, y, dx, dy, BGColor
  
  RowIdx = Index - CurTopIndex
  If RowIdx >= 0 And RowIdx < Rs.RecordCount Then
    FileName = Rs.ValueMatrix(RowIdx, 4) & Rs.ValueMatrix(RowIdx, 3)
    For i = 1 To VList.ColWidths.Count 'loop over the ColWidths, as they were gathered in the OwnerDrawHeader-Event above
      If i = 1 And ThmbCache.Exists(FileName) Then 'render the cached Image in Column 1
        CC.Paint , Cairo.CreateSolidPatternLng(BGColor)
        CC.RenderSurfaceContent ThmbCache.ImgSrf(FileName), 0, 0, CC.Surface.Width, CC.Surface.Height
        CC.Surface.DrawToDC hDC, x + 7, y
      
      ElseIf i = 2 And ThmbCache.Exists(FileName) Then 'render the cached Image-Dimension-String in Column 2
        VList.DrawTextCell hDC, ThmbCache.ImgDim(FileName), DT_RIGHT, x, y, VList.ColWidths(2), VList.RowHeight, , , , 5
      
      ElseIf i >= 3 Then 'from Col 3 onwards we just render the Rs-Contents directly as Text
        VList.DrawTextCell hDC, Rs.ValueMatrix(RowIdx, i - 3), IIf(i < 6, DT_RIGHT, DT_LEFT), x, y, VList.ColWidths(i), dy, , , , 5
      End If
      x = x + VList.ColWidths(i): If i < VList.ColWidths.Count Then VList.DrawLineVert hDC, x - 1, y, dy
    Next
    VList.DrawLineHorz hDC, 0, y + dy - 1, dx, &HBBBBBB
  End If
End Sub

Private Sub tmrUpdateResults_Timer() 'a highfrequent timer, which is always on, but in the normal case does nothing CPU-intensive
  If TH Is Nothing Or Cnn Is Nothing Then Exit Sub
  
  cmdStartScan.Enabled = TH.JobQueueCount = 0
  cmdCancelScan.Enabled = Not cmdStartScan.Enabled
  
  If TH.JobQueueCount Then Caption = "Files found so far: " & FilesCount
  
  If VList.ListCount <> FilesCount Then VList.ListCount = FilesCount
  If Not ThmbCache.SyncToRs(Rs, VList.RowHeight - 1) Then VList.Refresh
End Sub

Private Sub Form_Terminate()
  If Forms.Count = 0 Then New_c.CleanupRichClientDll
End Sub
